perm filename DPYSUB.SAI[SYS,HE]1 blob
sn#004162 filedate 1972-09-25 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 ENTRY CALCOMP
00006 00003 ⊃ Declarations for display functions
00010 00004 ⊃ ********* Super wonderful array graphing functions ********
00012 00005 INTERNAL SIMPLE INTEGER PROCEDURE ARRGRF(INTEGER_ARRAY AINTEGER I0,IM,X0,Y0,NX,NYSTRING XUNIT,YUNIT)
00015 00006 SIMPLE PROCEDURE DDOUT(INTEGER_ARRAY DDBUF)
00017 00007 DEFINE DDSIZX="512",DDSIZY="480"
00019 00008 INTERNAL INTEGER GFSIZX,GFSIZY,GFSIZL,X0,Y0,SCALX,SCALY,XCENT,YCENT,LMAR,RMAR,YBOT,CHSCAL
00022 00009 INTERNAL SIMPLE PROCEDURE IIICVT(INTEGER_ARRAY DPYBUF)
00024 ENDMK
⊗;
ENTRY CALCOMP;
BEGIN "DPYSUB"
DEFINE ⊃="COMMENT",REAL_ARRAY="SAFE REAL ARRAY",STRING_ARRAY="SAFE STRING ARRAY",
INTEGER_ARRAY="SAFE INTEGER ARRAY",PICTURE="SAFE INTEGER ARRAY",
SAFE_OWN="PRELOAD_WITH 0;OWN ";
DEFINE PI="3.141592653",PICON="(PI/180)";
⊃ This file contains a collection of useful definitions;
⊃ ****** Picture header definitions;
DEFINE SCALEX="0",SCALEY="1",POSX="2",POSY="3",SIZEX="4",SIZEY="5",
SIZEL="6",PTR="7",NAME="8",BIT="9",GAIN="10",OFFSET="11",PSCALE="10000",PICMAX="11";
⊃ The above definitions refer to locations in a "picture" header.
SCALEX,Y refers to the pixel grid spacing. The original picture has
SCALEX,Y=1. An NxN spacial average would change SCALEX,Y to N.
SIZEX,Y are the X,Y dimensions of the picture.
SIZEL is the # words per line.
POSX,Y are the coordinates of the upper left of the picture.
When extracting windows from a picture, POSX,Y define the
position of the window.
PTR is a byte pointer pointing one before the first pixel in the picture.
BIT is the # bits per pixel.
GAIN and OFFSET describe a linear rescaling of the intensities of each
in the image to best utilize the number of bits per point
which is provided in the array. In particular, GAIN and
OFFSET relate a sample in an image to its "true" light value
as follows:
sample value = GAIN / PSCALE * ("true" light value - OFFSET / PSCALE );
DEFINE HALT="JRST 4,",BOMB="CALL(0,""EXIT"")";
DEFINE XPOINT(S,L,P)="((35-(P))LSH 30)+((S) LSH 24)+(L LAND '777777)";
⊃ XPOINT is the same as point except that the value of L is the location
rather than the address of L;
DEFINE INFINITY="'377777777777";
DEFINE HAT(X,Y)="((((X)-1) DIV (Y)) +1)";
⊃ Declarations for display functions;
EXTERNAL PROCEDURE RVECT(INTEGER X,Y);
EXTERNAL PROCEDURE RIVECT(INTEGER X,Y);
EXTERNAL PROCEDURE RPT(INTEGER X,Y);
EXTERNAL PROCEDURE RPOINT(INTEGER X,Y);
EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
EXTERNAL PROCEDURE APT(INTEGER X,Y);
EXTERNAL PROCEDURE APOINT(INTEGER X,Y);
EXTERNAL PROCEDURE GVECT(INTEGER X,Y,OP,SIZ,BRT);
EXTERNAL INTEGER PROCEDURE AVECW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE AIVECW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE APOINW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE RVECW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE RPOINW(INTEGER X,Y);
EXTERNAL PROCEDURE DPYSET(INTEGER_ARRAY BUF);
EXTERNAL INTEGER PROCEDURE DPYPARS;
EXTERNAL PROCEDURE DPYRESET(INTEGER BUF);
EXTERNAL INTEGER PROCEDURE GETPOG;
EXTERNAL PROCEDURE RELPOG(INTEGER POG);
EXTERNAL PROCEDURE CLRBFR;
EXTERNAL PROCEDURE HYDPOG(INTEGER POG);
EXTERNAL PROCEDURE DPYOUT(INTEGER POG);
EXTERNAL PROCEDURE TYPLOC(INTEGER P1,P2);
EXTERNAL PROCEDURE NORELOPT;
EXTERNAL PROCEDURE RELOPT;
EXTERNAL PROCEDURE PGSEL(INTEGER POG);
EXTERNAL PROCEDURE UPGMVM(INTEGER VAL;REFERENCE INTEGER ADR);
EXTERNAL INTEGER PROCEDURE UPGMVE(REFERENCE INTEGER ADR);
EXTERNAL PROCEDURE DPYCLR;
EXTERNAL PROCEDURE DPYBIG(INTEGER SIZE);
EXTERNAL PROCEDURE DPYBRT(INTEGER BRT);
EXTERNAL PROCEDURE DPYSST(STRING S);
EXTERNAL INTEGER DPYPTR;
EXTERNAL INTEGER PROCEDURE DPYTST;
EXTERNAL PROCEDURE ACPOGS(INTEGER MASK);
EXTERNAL PROCEDURE ACCPOG(INTEGER POG);
EXTERNAL PROCEDURE DACPOG(INTEGER POG);
EXTERNAL INTEGER POGON;
EXTERNAL INTEGER PROCEDURE GVECW(INTEGER X,Y,OP,SIZ,BRT);
FORWARD INTERNAL SIMPLE PROCEDURE DPYSTR(INTEGER X,Y;STRING STR);
⊃ ********* Super wonderful array graphing functions ********;
INTERNAL SIMPLE INTEGER PROCEDURE MKSCALE(INTEGER X0,Y0;REAL DX,DY,NUMDIST;INTEGER I0,IM;STRING UNITS);
⊃ Draws an axis scale for a graph. X0,Y0 specify the origin of the
graph. DX,DY specify the direction (and scale) of the axis. I0,IM
specify the numeric range of the axis labelling. UNITS is the name
of the axis. Returns the distance between minor "tic" marks on the
axis;
BEGIN INTEGER EX,EY,EI,I,DI,DIN,K;
REAL DL;
DL←ABS(DX)+ABS(DY);
DIN←5;K←1;
WHILE DIN*DL<NUMDIST DO
DIN←DIN*(CASE (K←K+1) MOD 3 OF (2.5,2.0,2.0));
DI←DIN DIV 5;
IF ¬UNITS THEN RETURN(DI);
EX←(-10*DX)/DL;
EY←(-10*DY)/DL;
AIVECT(X0+(IM-I0)*DX,Y0+(IM-I0)*DY);
DPYSST(UNITS);
AIVECT(X0+(IM-I0)*DX,Y0+(IM-I0)*DY);
EI←I0 MOD DI;
IF EI≠0 THEN EI←DI-EI;
X0←X0+EI*DX;
Y0←Y0+EI*DY;
AVECT(X0,Y0);
I0←I0+EI;
FOR I←I0 STEP DI UNTIL IM DO
BEGIN
IF I MOD DIN =0 THEN
BEGIN RVECT(3*EY,3*EX);
DPYSST(CVS(I));
END
ELSE
RVECT(EY,EX);
AIVECT(X0←X0+DI*DX,Y0←Y0+DI*DY);
END;
RETURN(DI);
END "MKSCALE";
INTERNAL SIMPLE INTEGER PROCEDURE ARRGRF(INTEGER_ARRAY A;INTEGER I0,IM,X0,Y0,NX,NY;STRING XUNIT,YUNIT);
⊃ Graphs array A with subscripts in the range I0 to IM, with origin
at X0,Y0 and dimensions NX and NY. The axes are labelled XUNIT and
YUNIT. If I0=IM then the actual array bounds are used for I0 and IM.
NX=0 allows one to overlay a graph on a previous graph, without
relabelling or rescaling the axes;
BEGIN INTEGER I,J,QX,QY,MIN,MAX,X,AI,C,M,XGRID,YGRID,WID,DIG;
REAL DX,DY;LABEL L1;
GETFORMAT(WID,DIG);SETFORMAT(1,0);
IF I0=IM THEN BEGIN I0←ARRINFO(A,1);IM←ARRINFO(A,2) END;
IF NX≠0 THEN ⊃ Own style variables;
BEGIN
MIN←MAX←A[I0];
FOR I←I0+1 STEP 1 UNTIL IM DO ⊃ Determine the min and max;
IF (AI←A[I])>MAX THEN MAX←AI ELSE IF AI<MIN THEN MIN←AI;
DX←NX/(IM-I0);DY←NY/(MAX-MIN); ⊃ Scale the axes;
XGRID←MKSCALE(X0,Y0,DX,0,100,I0,IM,XUNIT);
YGRID←MKSCALE(X0,Y0,0,DY,40,MIN,MAX,YUNIT);⊃ Draw the axes;
QY←YGRID*DY;QX←XGRID*DX;
END;
AIVECT(X0,QY*A[I0] DIV YGRID-QY*MIN DIV YGRID+Y0);
J←I0;
DO BEGIN
M←A[J+1]-A[J];
C←A[J]-M*J;
FOR I←J+2 STEP 1 UNTIL IM DO
IF A[I]≠I*M+C THEN BEGIN I←I-1;GO TO L1 END;
I←IM;
L1: RVECT(QX*I DIV XGRID-QX*J DIV XGRID,QY*A[I] DIV YGRID-QY*A[J] DIV YGRID);
J←I;
END
UNTIL J=IM;
SETFORMAT(WID,DIG);
RETURN(MAX);
END "ARRGRF";
SIMPLE PROCEDURE DDOUT(INTEGER_ARRAY DDBUF);
BEGIN INTEGER FOO,FOO2;
FOO←POINT(0,DDBUF[1],35);
FOO2←ARRINFO(DDBUF,0);
START_CODE DEFINE UPGIOT="'715140000000";
UPGIOT FOO;
END;
END "DDOUT";
INTERNAL INTEGER DDCHAN;
INTERNAL PROCEDURE DDCLR;
BEGIN INTEGER I,WD;DEFINE INVERT="'10000000000";
INTEGER ARRAY DDBUF[1:3];
WD←'126004001324+INVERT;
DPB(DDCHAN,POINT(8,WD,23));
DDBUF[1]←WD;DDBUF[2]←WD;
DDOUT(DDBUF);
END "DDCLR";
INTERNAL BOOLEAN OVERLAY;
SIMPLE PROCEDURE DDFIX(INTEGER CHAN;INTEGER ARRAY DDBUF;INTEGER C0,L0,LL,SIZL);
BEGIN INTEGER CHANWD,DDPTR,DDLNO,FIELD,CWD;
CHANWD←'002004003324;DPB(CHAN,POINT(8,CHANWD,23));DPB(C0,POINT(7,CHANWD,15));
CWD←'116000001454+(IF OVERLAY THEN '040000000000 ELSE 0);
DDPTR←POINT(36,DDBUF[1],-1);
FOR FIELD←0 STEP 1 UNTIL 3 DO
BEGIN "FIELD"
FOR DDLNO←L0+FIELD STEP 4 UNTIL LL DO
BEGIN "LINE"
DPB(DDLNO,POINT(4,CWD,23));
DPB(DDLNO LSH -4,POINT(5,CWD,15));
IDPB(CWD,DDPTR);IDPB(CHANWD,DDPTR);
DDPTR←DDPTR+SIZL;
CWD←'454;
END "LINE";
END "FIELD";
IDPB('000004010334,DDPTR);IDPB(0,DDPTR);
END "DDFIX";
DEFINE DDSIZX="512",DDSIZY="480";
PROCEDURE DDSTR(STRING STR;INTEGER X0,Y0,PICWID,NLINES,CHAN);
BEGIN INTEGER N,LIN,BITS;
DEFINE CR="'15",LF="'12",TAB="'11";
INTEGER_ARRAY BUF[1:N←(LENGTH(STR) MIN (PICWID DIV 6-3)) DIV 5 +9];
INTEGER I,DDPTR,C,IM;
IF X0<0 THEN X0←0;
Y0←Y0 LAND -2;
LIN←1;
WHILE STR∧Y0<DDSIZY-12∧LIN≤NLINES DO
BEGIN
BUF[1]←'154000001454;DPB(Y0,POINT(4,BUF[1],23));
DPB(Y0 LSH -4,POINT(5,BUF[1],15));
BUF[2]←'002004003324;
DPB(X0 DIV 6+1,POINT(7,BUF[2],15));
FOR I←3 STEP 1 UNTIL N-5 DO BUF[I]←1;
DDPTR←POINT(7,BUF[3],-1);
I←5*(N-8);
WHILE STR∧I>0 DO
BEGIN IF (C←LOP(STR))=CR THEN BEGIN C←LOP(STR);DONE;END;
IF C≠LF∧C≠TAB THEN BEGIN I←I-1;IDPB(C,DDPTR);END;
END;
BUF[N-4]←'0504;DPB(Y0+1,POINT(4,BUF[N-4],15));
BUF[N-3]←'2554;DPB(Y0,POINT(4,BUF[N-3],23));
BUF[N-2]←BUF[N-4];
BUF[N-1]←BUF[N]←0;
DPB(CHAN,POINT(8,BUF[2],23));
DPB(CHAN,POINT(7,BUF[N-3],7));
DDOUT(BUF);
Y0←Y0+10;LIN←LIN+1;
END;
END "DDSTR";
INTERNAL SIMPLE PROCEDURE DPYSTR(INTEGER X,Y;STRING STR);
IF DPYTST≠1 THEN BEGIN AIVECT(X,Y);DPYSST(STR);END
ELSE DDSTR(STR,(X+512) DIV 2,(512-Y)*480 DIV 1024,512,50,0);
INTERNAL INTEGER GFSIZX,GFSIZY,GFSIZL,X0,Y0,SCALX,SCALY,XCENT,YCENT,LMAR,RMAR,YBOT,CHSCAL;
INTERNAL REAL ASPECT,CHASP,SQALE;
INTERNAL INTEGER DDPOSX,DDPOSY,DDORGX,DDORGY;
EXTERNAL PROCEDURE IIIWD(INTEGER WD);
INTERNAL PROCEDURE IIISUB(INTEGER_ARRAY DPYBUF;INTEGER DDCHAN);
BEGIN INTEGER IFRST;
IFRST←DDPOSX LAND 7;
GFSIZL←(IFRST+GFSIZX-1) LSH -5 +1;
BEGIN
INTEGER_ARRAY DDBUF[1:GFSIZY*(2+GFSIZL)+10];
INTERNAL INTEGER_ARRAY PTTAB[0:GFSIZX],LINTAB[0:GFSIZY-1];
INTEGER LIN,FPT,PTPT,OPT,DPSIZ;
INTEGER I,OP,DPWD,FIELD,DPYLO,DPYHI;
DEFINE DDCODE="2";
DPYLO←ARRINFO(DPYBUF,1);
DPSIZ←DPYBUF[DPYLO+1];
DPYHI←DPYLO+DPSIZ+1;
FPT←POINT(1,DDBUF[3],IFRST-1);
PTPT←POINT(36,PTTAB[0],-1);
OPT←POINT(1,DDBUF[3],-1);
START_CODE
DEFINE PT="1",J="2",II="3";LABEL LI,LJ,LE;
MOVE PT,FPT;MOVEI II,31;SUB II,IFRST;MOVE J,GFSIZX;
LJ: ADD PT,['4000000];
LI: IBP PT;IDPB PT,PTPT;SOJLE J,LE;SOJGE II,LI;
AOS PT,OPT;MOVEI II,31;JRST LJ;
LE: END;
I←0;
FOR FIELD←0 STEP 1 UNTIL 3 DO
FOR LIN←FIELD STEP 4 UNTIL GFSIZY-1 DO
BEGIN LINTAB[LIN]←I*(GFSIZL+2);I←I+1;END;
DDBUF[1]←DDCODE;ARRBLT(DDBUF[2],DDBUF[1],ARRINFO(DDBUF,0)-1);
IIIWD(GVECW(0,0,'146,2,0));
I←DPYLO+2;
WHILE I≤DPYHI DO
BEGIN INTEGER WD;
WD←DPYBUF[I];
IF WD LAND '37 ='20 THEN I←WD LSH -18
ELSE BEGIN I←I+1;IIIWD(WD);END;
END;
DDFIX(DDCHAN,DDBUF,DDPOSX LSH -3+1,DDPOSY,DDPOSY+GFSIZY-1,GFSIZL);
DDOUT(DDBUF);
END;
END "IIISUB";
INTERNAL SIMPLE PROCEDURE IIICVT(INTEGER_ARRAY DPYBUF);
BEGIN
IF ASPECT=0 THEN ASPECT←.85;
⊃ IF CHASP=0 THEN CHASP←ASPECT;
CHASP←1;
GFSIZX←512;GFSIZY←480;GFSIZL←16;
IF SQALE=0 THEN SQALE←480/1024;
SCALY←SQALE*(1 LSH 18);
SCALX←ASPECT*SCALY;
⊃ IF CHSCAL=0 THEN CHSCAL←SCALY;
CHSCAL←(1 LSH 17);
XCENT←256 LSH 18;YCENT←240 LSH 18;
LMAR←0;RMAR←1023*SCALX;
YBOT←479 LSH 18;
IIISUB(DPYBUF,0);
END "IIICVT";
INTERNAL SIMPLE PROCEDURE III2DD(INTEGER_ARRAY DPYBUF);
BEGIN SQALE←ASPECT←1;
SCALX←1 LSH 18;SCALY←-1 LSH 18;
IF CHSCAL=0 THEN CHSCAL←1 LSH 17;CHASP←1;
XCENT←SCALX*(DDORGX-DDPOSX);YCENT←SCALX*(DDORGY-DDPOSY);
DPYPARS;
LMAR←0;RMAR←GFSIZX*SCALX;YBOT←GFSIZY*SCALX;
IIISUB(DPYBUF,DDCHAN);
END "III2DD";
INTERNAL SIMPLE PROCEDURE DDOVER(PICTURE PIC;INTEGER ARRAY DPYBUF;INTEGER NXX,NYY,L);
BEGIN
INTEGER IX,IY,XX0,YY0,WX,WY;
IY←L DIV NXX;
IX←L MOD NXX;
WX←(DDSIZX) DIV (NXX*2);
WY←(DDSIZY) DIV (NYY*2);
XX0←(2*IX+1)*WX-PIC[SIZEX] DIV 2;
YY0←(2*IY+1)*WY-PIC[SIZEY] DIV 2-10;
DDPOSX←DDORGX←XX0;
DDPOSY←DDORGY←YY0;
GFSIZX←PIC[SIZEX];
GFSIZY←PIC[SIZEY];
III2DD(DPYBUF);
END "DDOVER";
END "DPYSUB";